home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / CMPLTPAS / FONT.PAS < prev    next >
Pascal/Delphi Source File  |  1988-07-14  |  5KB  |  138 lines
  1. {--------------------------------------------------------------}
  2. {                            FONT                              }
  3. {                                                              }
  4. {      Display adapter text font query and change utility      }
  5. {                                                              }
  6. {                             by Jeff Duntemann                }
  7. {                             Turbo Pascal V4.0                }
  8. {                             Last update 7/1/88               }
  9. {                                                              }
  10. { From the book, COMPLETE TURBO PASCAL 5.0   by Jeff Duntemann }
  11. {           Scott, Foresman & Co.  ISBN 0-673-38355-5          }
  12. {--------------------------------------------------------------}
  13.  
  14. PROGRAM Font;
  15.  
  16. USES Crt,DOS;
  17.  
  18. TYPE
  19.   AdapterType = (None,MDA,CGA,EGAMono,EGAColor,VGAMono,
  20.                   VGAColor,MCGAMono,MCGAColor);
  21.   FontSizes   = SET OF Byte;
  22.  
  23. CONST
  24.   AdapterStrings : ARRAY[AdapterType] OF String =
  25.                      ('None','MDA','CGA','EGAMono','EGAColor',
  26.                       'VGAMono','VGAColor','MCGAMono','MCGAColor');
  27.  
  28.  
  29. VAR
  30.   InstalledAdapter : AdapterType;
  31.   LegalSizes       : FontSizes;
  32.   AdapterSizes     : FontSizes;
  33.   ErrorPos         : Integer;
  34.   ErrorSize        : String;
  35.   NewFont          : Byte;
  36.   FontCode         : Byte;
  37.   OldAdapters      : SET OF AdapterType;
  38.   Regs             : Registers;
  39.  
  40.  
  41. {$I QUERYDSP.SRC}  { Contains function QueryAdapterType; see Section 18.4 }
  42.  
  43. {$I FONTSIZE.SRC}  { Contains function DeterminePoints; see Section 18.4 }
  44.  
  45.  
  46. PROCEDURE ShowFontSizeError(BadSize : String);
  47.  
  48. BEGIN
  49.   Writeln(BadSize,' is not a valid font size.');
  50.   Writeln('Legal values are 8, 14, and 16,');
  51.   Writeln('*if* your display adapter supports them.')
  52. END;
  53.  
  54.  
  55.  
  56. BEGIN   { MAIN }
  57.   LegalSizes := [8,14,16];  { IBM adapters only use these three sizes }
  58.   OldAdapters := [CGA,MDA]; { The CGA and MDA cannot change fonts }
  59.  
  60.   IF ParamCount < 1 THEN
  61.     BEGIN
  62.       InstalledAdapter := QueryAdapterType;
  63.       Writeln('>>FONT<<  V1.1 by Jeff Duntemann');
  64.       Writeln('          From the book, COMPLETE TURBO PASCAL 5.0');
  65.       Writeln('          ISBN 0-673-38355-5');
  66.       Writeln;
  67.       Writeln('The installed adapter is: ',
  68.                AdapterStrings[InstalledAdapter]);
  69.       Writeln('The current font size is: ',DeterminePoints);
  70.       Writeln;
  71.       Writeln
  72.       ('To change the current font size, invoke FONT.EXE with the desired');
  73.       Writeln
  74.       ('font size as the only parameter, which must be one of 8, 14, or 16:');
  75.       WRiteln; Writeln('   C>FONT 14'); WRITELN;
  76.       Writeln('Remember that the font size of the CGA and MDA cannot change.');
  77.       Writeln
  78. ('The EGA supports 8 and 14, while the VGA supports 8, 14, or 16.');
  79.       Writeln('The MCGA supports the 16 pixel font size *only*.');
  80.       Writeln
  81. ('FONT.EXE passes the current font size in ERRORLEVEL for use in batch files.');
  82.       Halt(DeterminePoints)  { Make point size available in ERRORLEVEL }
  83.       { THIS IS AN EXIT POINT FROM FONT.PAS!!! }
  84.     END
  85.   ELSE
  86.     BEGIN
  87.       Val(ParamStr(1),NewFont,ErrorPos);
  88.       IF ErrorPos <> 0 THEN ShowFontSizeError(ParamStr(2))
  89.       ELSE
  90.         IF NOT (NewFont IN LegalSizes) THEN
  91.           BEGIN
  92.             Str(NewFont,ErrorSize);
  93.             ShowFontSizeError(ErrorSize)
  94.           END
  95.         ELSE      { At this point entered font size is OK... }
  96.           BEGIN   { ...but we must be sure the adapter supports it: }
  97.             InstalledAdapter := QueryAdapterType;
  98.             CASE InstalledAdapter OF
  99.               CGA                : AdapterSizes := [8];
  100.               MDA                : AdapterSizes := [14];
  101.               EGAMono,EGAColor   : AdapterSizes := [8,14];
  102.               VGAMono,VGAColor   : AdapterSizes := [8,14,16];
  103.               MCGAMono,MCGAColor : AdapterSizes := [16];
  104.             END;  { CASE }
  105.             IF NOT (NewFont IN AdapterSizes) THEN
  106.               BEGIN
  107.                 Writeln('That font size does not exist');
  108.                 Writeln('on your display adapter.')
  109.               END
  110.             ELSE      { Finally, do the font switch }
  111.               BEGIN
  112.                 ClrScr;
  113.                 IF NOT (InstalledAdapter IN OldAdapters) THEN
  114.                   BEGIN
  115.                     CASE NewFont OF
  116.                       8  : FontCode := $12;
  117.                       14 : FontCode := $11;
  118.                       16 : FontCode := $10;
  119.                     END;  { CASE }
  120.                     Regs.AH := $11;  { EGA/VGA character generator services }
  121.                     Regs.AL := FontCode;  { Plug in the code for this size... }
  122.                     Regs.BX := 0;
  123.                     Intr($10,Regs);  { ...and make the BIOS call. }
  124.                     { Suppress BIOS cursor emulation: }
  125.                     MEM[$40:$87] := MEM[$40:$87] OR $01;
  126.                     { Now reset the cursor to the appropriate lines: }
  127.                     Regs.AX := $100;
  128.                     Regs.BX := 0;
  129.                     Regs.CL := 0;
  130.                     Regs.CH := NewFont - 2;  { i.e., 6, 12, or 14 }
  131.                     Intr($10,Regs);  { Make the BIOS call. }
  132.                     HALT(DeterminePoints);
  133.                   END
  134.               END
  135.           END
  136.     END
  137. END.
  138.